home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / bix02.arc / CIRCLE.PAS < prev    next >
Pascal/Delphi Source File  |  1986-08-04  |  2KB  |  92 lines
  1. {generates Pascal code for inclusion in fast circle/arc drawing program}
  2. {TITLE: Circle/Arc Animation}
  3.  
  4. Program GenConst;
  5. type trigtable=array[0..90] of byte;
  6. const pi=3.14159265;
  7. var f:text;i,j,k:integer;
  8. function mycos(d:real):real;
  9. begin
  10. mycos:=cos(pi*d/180.0)
  11. end;
  12.  
  13. function mysin(d:real):real;
  14. begin
  15. mysin:=sin(pi*d/180.0)
  16. end;
  17.  
  18. procedure genarc(radius,start,last:integer);
  19. var y:array[-199..199] of array[0..1] of integer;
  20. px,fpx,py,fpy,i,j,k,l,m:integer;
  21. procedure jot(xx,yy:integer);
  22. var i:integer;
  23. begin
  24. if y[yy][0]=9999 then y[yy][0]:=xx else
  25. begin
  26. if y[yy][1]=9999 then y[yy][1]:=xx;
  27. if y[yy][0]>y[yy][1] then
  28. begin
  29. i:=y[yy][0];y[yy][0]:=y[yy][1];y[yy][1]:=i
  30. end;
  31. if xx<y[yy][0] then y[yy][0]:=xx else
  32. if xx>y[yy][1] then y[yy][1]:=xx
  33. end;
  34. end;
  35.  
  36. begin
  37. fpx:=-1000;fpy:=-1000;
  38. for i:=-199 to 199 do begin y[i][0]:=9999;y[i][1]:=9999 end;
  39. for i:=4*start to 4*last do
  40.  begin
  41.   py:=-round(mysin(i/4.0)*radius);
  42.   px:=round(mycos(i/4.0)*radius/0.44);
  43.   jot(px,py);
  44.   if fpx=-1000 then fpx:=px;
  45.   if fpy=-1000 then fpy:=py;
  46.  end;
  47. if fpy<=0 then for i:=fpy to 0 do
  48. if fpy=0 then jot(0,i) else
  49. jot(round(fpx*i/fpy),i)
  50. else
  51. for i:=0 to fpy do
  52. if fpy=0 then jot(0,i) else
  53. jot(round(fpx*i/fpy),i);
  54. if py<=0 then for i:=py to 0 do
  55. begin
  56. if py=0 then j:=0 else
  57. j:=round(px*i/py);
  58. jot(j,i);
  59. end
  60. else
  61. for i:=0 to py do
  62. begin
  63. if py=0 then j:=0 else
  64. j:=round(px*i/py);
  65. jot(j,i)
  66. end;
  67. j:=9999;
  68. for i:=-199 to 199 do
  69. if y[i][1]<>9999 then
  70. begin
  71. if j=9999 then j:=i;
  72. k:=i;
  73. end;
  74. writeln(f,'Type gdata=record x1,x2:integer end;');
  75. writeln(f,'Const sdata=',j,'; edata=',k,';');
  76. writeln(f,'      data:array[sdata..edata] of gdata =');
  77. writeln(f,'    (');
  78. for i:=j to k do
  79. begin
  80. write(f,'     (x1:',y[i][0],';x2:',y[i][1],')');
  81. if i<>k then writeln(f,',') else writeln(f,');');
  82. end;
  83. end;
  84.  
  85. begin
  86. assign(f,'fastarc.inc');
  87. rewrite(f);
  88. write('Enter 3 numbers for radius start end...');readln(i,j,k);
  89. genarc(i,j,k);
  90. close(f);
  91. end.
  92.